home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2009 February / PCWFEB09.iso / Software / Linux / Kubuntu 8.10 / kubuntu-8.10-desktop-i386.iso / casper / filesystem.squashfs / usr / share / perl5 / Debconf / Question.pm < prev    next >
Encoding:
Perl POD Document  |  2008-10-10  |  5.7 KB  |  293 lines
  1. #!/usr/bin/perl -w
  2. # This file was preprocessed, do not edit!
  3.  
  4.  
  5. package Debconf::Question;
  6. use strict;
  7. use Debconf::Db;
  8. use Debconf::Template;
  9. use Debconf::Iterator;
  10. use Debconf::Log qw(:all);
  11.  
  12.  
  13. use fields qw(name priority);
  14.  
  15. our %question;
  16.  
  17.  
  18. sub new {
  19.     my Debconf::Question $this=shift;
  20.     my $name=shift;
  21.     my $owner=shift;
  22.     my $type=shift || die "no type given for question";
  23.     die "A question called \"$name\" already exists"
  24.         if exists $question{$name};
  25.     unless (ref $this) {
  26.         $this = fields::new($this);
  27.     }
  28.     $this->{name}=$name;
  29.     return unless defined $this->addowner($owner, $type);
  30.     $this->flag('seen', 'false');
  31.     return $question{$name}=$this;
  32. }
  33.  
  34.  
  35. sub get {
  36.     my Debconf::Question $this=shift;
  37.     my $name=shift;
  38.     return $question{$name} if exists $question{$name};
  39.     if ($Debconf::Db::config->exists($name)) {
  40.         $this = fields::new($this);
  41.         $this->{name}=$name;
  42.         return $question{$name}=$this;
  43.     }
  44.     return undef;
  45. }
  46.  
  47.  
  48. sub iterator {
  49.     my $this=shift;
  50.  
  51.     my $real_iterator=$Debconf::Db::config->iterator;
  52.     return Debconf::Iterator->new(callback => sub {
  53.         return unless my $name=$real_iterator->iterate;
  54.         return $this->get($name);
  55.     });
  56. }
  57.  
  58.  
  59. sub _expand_vars {
  60.     my $this=shift;
  61.     my $text=shift;
  62.         
  63.     return '' unless defined $text;
  64.  
  65.     my @vars=$Debconf::Db::config->variables($this->{name});
  66.     
  67.     my $rest=$text;
  68.     my $result='';
  69.     my $variable;
  70.     my $varval;
  71.     my $escape;
  72.     while ($rest =~ m/^(.*?)(\\)?\${([^{}]+)}(.*)$/sg) {
  73.         $result.=$1;  # copy anything before the variable
  74.         $escape=$2;
  75.         $variable=$3;
  76.         $rest=$4; # continue trying to expand rest of text
  77.         if (defined $escape && length $escape) {
  78.             $result.="\${$variable}";
  79.         }
  80.         else {
  81.             $varval=$Debconf::Db::config->getvariable($this->{name}, $variable);
  82.             $result.=$varval if defined($varval); # expand the variable
  83.         }
  84.     }
  85.     $result.=$rest; # add on anything that's left.
  86.     
  87.     return $result;
  88. }
  89.  
  90.  
  91. sub description {
  92.     my $this=shift;
  93.     return $this->_expand_vars($this->template->description);
  94. }
  95.  
  96.  
  97. sub extended_description {
  98.     my $this=shift;
  99.     return $this->_expand_vars($this->template->extended_description);
  100. }
  101.  
  102.  
  103. sub choices {
  104.     my $this=shift;
  105.     
  106.     return $this->_expand_vars($this->template->choices);
  107. }
  108.  
  109.  
  110. sub choices_split {
  111.     my $this=shift;
  112.     
  113.     my @items;
  114.     my $item='';
  115.     for my $chunk (split /(\\[, ]|,\s+)/, $this->choices) {
  116.         if ($chunk=~/^\\([, ])$/) {
  117.             $item.=$1;
  118.         } elsif ($chunk=~/^,\s+$/) {
  119.             push @items, $item;
  120.             $item='';
  121.         } else {
  122.             $item.=$chunk;
  123.         }
  124.     }
  125.     push @items, $item if $item ne '';
  126.     return @items;
  127. }
  128.  
  129.  
  130. sub variable {
  131.     my $this=shift;
  132.     my $var=shift;
  133.     
  134.     if (@_) {
  135.         return $Debconf::Db::config->setvariable($this->{name}, $var, shift);
  136.     }
  137.     else {
  138.         return $Debconf::Db::config->getvariable($this->{name}, $var);
  139.     }
  140. }
  141.  
  142.  
  143. sub flag {
  144.     my $this=shift;
  145.     my $flag=shift;
  146.  
  147.     if ($flag eq 'isdefault') {
  148.         debug developer => "The isdefault flag is deprecated, use the seen flag instead";
  149.         if (@_) {
  150.             my $value=(shift eq 'true') ? 'false' : 'true';
  151.             $Debconf::Db::config->setflag($this->{name}, 'seen', $value);
  152.         }
  153.         return ($Debconf::Db::config->getflag($this->{name}, 'seen') eq 'true') ? 'false' : 'true';
  154.     }
  155.  
  156.     if (@_) {
  157.         return $Debconf::Db::config->setflag($this->{name}, $flag, shift);
  158.     }
  159.     else {
  160.         return $Debconf::Db::config->getflag($this->{name}, $flag);
  161.     }
  162. }
  163.  
  164.  
  165. sub value {
  166.     my $this = shift;
  167.     
  168.     unless (@_) {
  169.         my $ret=$Debconf::Db::config->getfield($this->{name}, 'value');
  170.         return $ret if defined $ret;
  171.         return $this->template->default if ref $this->template;
  172.     } else {
  173.         return $Debconf::Db::config->setfield($this->{name}, 'value', shift);
  174.     }
  175. }
  176.  
  177.  
  178. sub value_split {
  179.     my $this=shift;
  180.     
  181.     my $value=$this->value;
  182.     $value='' if ! defined $value;
  183.     my @items;
  184.     my $item='';
  185.     for my $chunk (split /(\\[, ]|,\s+)/, $value) {
  186.         if ($chunk=~/^\\([, ])$/) {
  187.             $item.=$1;
  188.         } elsif ($chunk=~/^,\s+$/) {
  189.             push @items, $item;
  190.             $item='';
  191.         } else {
  192.             $item.=$chunk;
  193.         }
  194.     }
  195.     push @items, $item if $item ne '';
  196.     return @items;
  197. }
  198.  
  199.  
  200. sub addowner {
  201.     my $this=shift;
  202.  
  203.     return $Debconf::Db::config->addowner($this->{name}, shift, shift);
  204. }
  205.  
  206.  
  207. sub removeowner {
  208.     my $this=shift;
  209.  
  210.     my $template=$Debconf::Db::config->getfield($this->{name}, 'template');
  211.     return unless $Debconf::Db::config->removeowner($this->{name}, shift);
  212.     if (length $template and 
  213.         not $Debconf::Db::config->exists($this->{name})) {
  214.         $Debconf::Db::templates->removeowner($template, $this->{name});
  215.         delete $question{$this->{name}};
  216.     }
  217. }
  218.  
  219.  
  220. sub owners {
  221.     my $this=shift;
  222.  
  223.     return join(", ", sort($Debconf::Db::config->owners($this->{name})));
  224. }
  225.  
  226.  
  227. sub template {
  228.     my $this=shift;
  229.     if (@_) {
  230.         my $oldtemplate=$Debconf::Db::config->getfield($this->{name}, 'template');
  231.         my $newtemplate=shift;
  232.         if (not defined $oldtemplate or $oldtemplate ne $newtemplate) {
  233.             $Debconf::Db::templates->removeowner($oldtemplate, $this->{name})
  234.                 if defined $oldtemplate and length $oldtemplate;
  235.  
  236.             $Debconf::Db::config->setfield($this->{name}, 'template', $newtemplate);
  237.  
  238.             $Debconf::Db::templates->addowner($newtemplate, $this->{name},
  239.                 $Debconf::Db::templates->getfield($newtemplate, "type"));
  240.         }
  241.     }
  242.     return Debconf::Template->get(
  243.         $Debconf::Db::config->getfield($this->{name}, 'template'));
  244. }
  245.  
  246.  
  247. sub name {
  248.     my $this=shift;
  249.  
  250.     return $this->{name};
  251. }
  252.  
  253.  
  254. sub priority {
  255.     my $this=shift;
  256.  
  257.     $this->{priority}=shift if @_;
  258.  
  259.     return $this->{priority};
  260. }
  261.  
  262.  
  263. sub AUTOLOAD {
  264.     (my $field = our $AUTOLOAD) =~ s/.*://;
  265.  
  266.     no strict 'refs';
  267.     *$AUTOLOAD = sub {
  268.         my $this=shift;
  269.  
  270.         if (@_) {
  271.             return $Debconf::Db::config->setfield($this->{name}, $field, shift);
  272.         }
  273.         my $ret=$Debconf::Db::config->getfield($this->{name}, $field);
  274.         unless (defined $ret) {
  275.             $ret = $this->template->$field() if ref $this->template;
  276.         }
  277.         if (defined $ret) {
  278.             if ($field =~ /^(?:description|extended_description|choices)-/i) {
  279.                 return $this->_expand_vars($ret);
  280.             } else {
  281.                 return $ret;
  282.             }
  283.         }
  284.     };
  285.     goto &$AUTOLOAD;
  286. }
  287.  
  288. sub DESTROY {
  289. }
  290.  
  291.  
  292. 1
  293.